(*
  Copyright (c) 2009 Barry Schwartz

  Permission is hereby granted, free of charge, to any person
  obtaining a copy of this software and associated documentation
  files (the "Software"), to deal in the Software without
  restriction, including without limitation the rights to use,
  copy, modify, merge, publish, distribute, sublicense, and/or sell
  copies of the Software, and to permit persons to whom the
  Software is furnished to do so, subject to the following
  conditions:

  The above copyright notice and this permission notice shall be
  included in all copies or substantial portions of the Software.

  THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,
  EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES
  OF MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND
  NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT
  HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY,
  WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING
  FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
  OTHER DEALINGS IN THE SOFTWARE.
*)

open XNum
open VMTypes
open UTypes
open SymbolTable
  
(* serialise *)
type ser_data = {
  stream : IO.ostream;
  mutable num_syms : int;
  mutable anon_syms : int SymbolMap.t
}

let empty_sym = string_to_symbol [|  |]
  
let write_symbol data sym =
  let str = symbol_to_string sym in
  let len = Array.length str in
    if len > 0 || sym = empty_sym then
      begin
        IO.printf data.stream "%d" len;
        Array.iter (fun c -> IO.write_be_u32 data.stream (num_of_int c)) str
      end
    else (* Special treatment of anonymous symbols. *)
      try
        let idx = SymbolMap.find sym data.anon_syms in
          IO.printf data.stream "@%d" idx
      with
        | Not_found ->
            data.num_syms <- data.num_syms + 1;
            data.anon_syms <- SymbolMap.add data.num_syms sym data.anon_syms;
            IO.printf data.stream "@%d" data.num_syms
  
let serialise_unknown os x =
  let data = { stream = os; num_syms = 0; anon_syms = SymbolMap.empty; } in
  let rec serialise data x =
    match !x with
      | Bool false -> IO.write_string data.stream "b0"
      | Bool true -> IO.write_string data.stream "b1"
      | Number n ->
          IO.write_char data.stream 'n';
          serialise_num (IO_Base.io_write_char data.stream) n
      | Char c -> IO.printf data.stream "c%d" c
      | Symbol s ->
          IO.write_char data.stream 's';
          write_symbol data s
      | Nil -> IO.write_char data.stream ']'
      | List (a, b) ->
          IO.write_char data.stream '[';
          serialise data a;
          serialise data b
      | Tuple xs ->
          IO.printf data.stream "(%d" (Array.length xs);
          Array.iter (serialise data) xs
      | Dictionary d ->
          let size = SymbolMap.fold (fun _ _ n -> n + 1) d 0 in
            IO.printf data.stream "{%d" size;
            SymbolMap.iter (fun k v -> (write_symbol data k; serialise data v)) d
      | Unbound | Constraint _ | LinForm _ | Primitive1 _ | Primitive2 _ |
            PrimitiveN (_, _) | Function (_, _, _) | Chain _ | Relation (_, _) |
                Application (_, _, _) | Opaque _ -> IO.write_char data.stream '?'
  in
    serialise data x
  
(* unserialise *)
type unser_data = {
  stream : IO.irstream;
  mutable anon_syms : symbol array
}

let read_integer is =
  let rec iter n =
    let c = int_of_char (IO.peek_char is 0) in
      if (c >= 48) && (c <= 57) then
        begin
          IO.skip is 1;
          iter (((10 * n) + c) - 48)
        end
      else
        n
  in
    iter 0
  
let read_symbol data =
  if (IO.peek_char data.stream 0) <> '@' then
    let l = read_integer data.stream in
    let str = Array.init l (fun _ -> int_of_num (IO.read_be_u32 data.stream)) in
      string_to_symbol str
  else
    let lookup_anon_symbol sym_array idx =
      let sym = sym_array.(idx)
      in
        if sym >= 0 then
          sym
        else
          let sym = alloc_symbol () in
            sym_array.(idx) <- sym;
            sym
    in
      IO.skip data.stream 1;
      let idx = read_integer data.stream
      in
        if idx < (Array.length data.anon_syms)
        then lookup_anon_symbol data.anon_syms idx
        else
          let old_len = Array.length data.anon_syms in
          let new_len = max (idx + 1) (2 * old_len) in
          let arr =
            Array.init new_len
              (fun i -> if i < old_len then data.anon_syms.(i) else (-1))
          in
            data.anon_syms <- arr;
            lookup_anon_symbol arr idx
  
let unserialise_unknown is =
  let data =
    { stream = (is :> IO.irstream);
      anon_syms = Array.make 16 (-1) } in
  let rec unserialise data =
    match IO.read_char is with
      | '?' -> Unbound
      | 'b' ->
          begin
            match IO.read_char is with
              | '0' -> Bool false
              | '1' -> Bool true
              | _ -> runtime_error "Corrupt data."
          end
      | 'c' -> Char (read_integer is)
      | 's' -> Symbol (read_symbol data)
      | 'n' -> Number (unserialise_num
                         (fun () -> IO_Base.io_read_char data.stream))
      | ']' -> Nil
      | '[' ->
          let a = unserialise data in
          let b = unserialise data in
            List (ref a, ref b)
      | '(' ->
          let l = read_integer is in
            Tuple (Array.init l (fun _ -> ref (unserialise data)))
      | '{' ->
          let l = read_integer is in
          let rec iter i d =
            if i <= 0 then
              Dictionary d
            else
              let k = read_symbol data in
              let v = unserialise data in
                iter (i - 1) (SymbolMap.add k (ref v) d)
          in
            iter l SymbolMap.empty
      | _ -> runtime_error "Corrupt data."
  in
    unserialise data
